home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / DCOM / CreateCOMObj / dispconcreate.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-07-14  |  2.0 KB  |  65 lines
  1. unit dispconcreate;
  2.  
  3. interface
  4. uses ActiveX;
  5.  
  6. function CreateRemoteComObjectDispIntf(const MachineName: WideString;
  7.   const ClassID: TGUID): IDispatch;
  8.  
  9. implementation
  10. uses Windows,Sysutils,ComObj;
  11.  
  12. type
  13.   TCoCreateInstanceExProc = function(const clsid: TCLSID;
  14.     unkOuter: IUnknown; dwClsCtx: Longint; ServerInfo: PCoServerInfo;
  15.     dwCount: Longint; rgmqResults: PMultiQIArray): HResult stdcall;
  16.  
  17. var
  18.   CoCreateInstanceEx: TCoCreateInstanceExProc = nil;
  19.  
  20. function CreateRemoteComObjectDispIntf(const MachineName: WideString;
  21.   const ClassID: TGUID): IDispatch;
  22. const
  23.   LocalFlags = CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER;
  24.   RemoteFlags = CLSCTX_REMOTE_SERVER;
  25. var
  26.   MQI: TMultiQI;
  27.   ServerInfo: TCoServerInfo;
  28.   AIID_Interface: TGuid;
  29.   Flags, Size: DWORD;
  30.   Ole32: HModule;
  31.   LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of char;
  32. begin
  33.  if @CoCreateInstanceEx = nil then
  34.   begin
  35.     Ole32 := GetModuleHandle('ole32.dll');
  36.     Win32Check(Ole32 > HINSTANCE_ERROR);
  37.     @CoCreateInstanceEx := GetProcAddress(Ole32, 'CoCreateInstanceEx');
  38.     if @CoCreateInstanceEx = nil then
  39.          raise Exception.Create('DCOM is not installed');
  40.   end;
  41.  
  42.   FillChar(ServerInfo, sizeof(ServerInfo), 0);
  43.   ServerInfo.pwszName := PWideChar(MachineName);
  44.   AIID_Interface := IDispatch;
  45.   MQI.IID        := @AIID_Interface;
  46.   MQI.itf := nil;
  47.   MQI.hr := 0;
  48.   { If a MachineName is specified check to see if it the local machine.
  49.     If it isn't, do not allow LocalServers to be used. }
  50.   if Length(MachineName) > 0 then
  51.   begin
  52.     Size := Sizeof(LocalMachine);  // Win95 is hypersensitive to size
  53.     if GetComputerName(LocalMachine, Size) and
  54.        (AnsiCompareText(LocalMachine, MachineName) = 0) then
  55.       Flags := LocalFlags else
  56.       Flags := RemoteFlags;
  57.   end else
  58.     Flags := LocalFlags;
  59.   OleCheck(CoCreateInstanceEx(ClassID, nil, Flags, @ServerInfo, 1, @MQI));
  60.   OleCheck(MQI.HR);
  61.   Result := MQI.itf as IDispatch;
  62. end;
  63.  
  64. end.
  65.